Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue31/delcom/ClassFactory.pas

Pascal/Delphi Source File | 1998-02-04 | 7.1 KB | 188 lines

unit ClassFactory;
{********************************************************************}
{**  Unit : ClassFactory                                           **}
{**                                                                **}
{**  Description : This unit contains the class factory for the    **}
{**  BMPProp shell extension class.                                **}
{**                                                                **}
{**  Version History :                                             **}
{**                                                                **}
{**  A0.01     Initial version started                   27/10/96  **}
{**                                                                **}
{** Copyright ⌐1996 David J. Fiddes                                **}
{********************************************************************}
interface
uses
  Windows, { Standard Unit }
  OLE2,

  Global; { Application specific units }

type
{********************************************************************}
{**  Object : TClassFactory                                        **}
{**                                                                **}
{**  Description : This is the Class Factory for the shell         **}
{**  extension. It creates a copy of TProperties, the main         **}
{**  object of the shell extension.                                **}
{**                                                                **}
{**  Version History :                                             **}
{**                                                                **}
{**  A0.01     Initial version started                   27/10/96  **}
{**                                                                **}
{********************************************************************}
  TClassFactory = class(IClassFactory)

    FRefCount : longint; { reference count for the object }

    constructor Create;
    destructor Destroy; override;

    {** IUnknown interface **}
    function QueryInterface(const iid: TIID; var obj):HResult; override;
    function AddRef:Longint; override;
    function Release:Longint; override;

    {** IClassFactory **}
    function CreateInstance(unkOuter: IUnknown; const iid: TIID; var obj):HResult; override;
    function LockServer(fLock: BOOL): HResult; override;
  end;


{********************************************************************}
implementation
uses
  Properties; { Application Specific Unit }


{********************************************************************}
{**  Method : TClassFactory.Create                                 **}
{**                                                                **}
{**  This is the constructor for the class factory. The reference  **}
{**  counter for the DLL is incremented and the object counter     **}
{**  setup                                                         **}
{********************************************************************}
constructor TClassFactory.Create;
begin
  inc(RefThisDLL); { I exist .'. keep me alive! }
  FRefCount:=0; {zero to start - incremented by QueryInterface}
end;


{********************************************************************}
{**  Method : TClassFactory.Destroy                                **}
{**                                                                **}
{**  This is the destructor for the class factory. The reference   **}
{**  counter for the DLL is decremented so that it cleans up.      **}
{********************************************************************}
destructor TClassFactory.Destroy;
begin
  dec(RefThisDLL);
end;


{********************************************************************}
{**  Method : TClassFactory.QueryInterface                         **}
{**                                                                **}
{**  This is the method return a pointer to the requested          **}
{**  interface. It will return a pointer for the IUnknown and      **}
{**  IClassFacotry interfaces.                                     **}
{********************************************************************}
function TClassFactory.QueryInterface(const iid: TIID; var obj):HResult;
var
  hr : hResult;
begin
  pointer(obj):=nil;
  hr:=E_NOINTERFACE;

  if ISEqualIID(iid,IID_IUnknown) OR ISEqualIID(iid,IID_IClassFactory) then
  begin
    pointer(obj):=Self;
    hr:=NOERROR;
    AddRef; {if it's OK then add a reference to it}
  end;

  Result:=hr;
end;


{********************************************************************}
{**  Method : TClassFactory.AddRef                                 **}
{**                                                                **}
{**  This method increments the object reference counter.          **}
{********************************************************************}
function TClassFactory.AddRef:longint;
begin
  inc(FRefCount);
  AddRef:=FRefCount;
end;


{********************************************************************}
{**  Method : TClassFactory.Release                                **}
{**                                                                **}
{**  This method decrements the object reference counter and       **}
{**  unloads the object if the counter is zero.                    **}
{********************************************************************}
function TClassFactory.Release:longint;
begin
  dec(FRefCount);
  Result:=FRefCount;
  if FRefCount=0 then Free;
end;


{********************************************************************}
{**  Method : TClassFactory.CreateInstance                         **}
{**                                                                **}
{**  This method creates and instance of the TPropertiesExt        **}
{**  object and checks that it's OK.                               **}
{********************************************************************}
function TClassFactory.CreateInstance( unkOuter: IUnknown; const iid: TIID; var obj):HResult;
var
  hr    : hResult;
  MyObj : TPropertiesExt;
begin
  pointer(obj):=nil;
  hr:=E_OUTOFMEMORY;
  if unkOuter<>nil then
  begin
    Result:=CLASS_E_NOAGGREGATION;
    exit;
  end;

  MyObj:=TPropertiesExt.Create; {create object and check for thicky errors}
  if MyObj=nil then
  begin
    Result:=hr;
    exit;
  end;

  hr:=MyObj.QueryInterface(iid,obj); {see if it supports the interface}

  if Failed(hr) then {if an error then get rid of it}
    MyObj.Destroy;

  Result:=hr;
end;


{********************************************************************}
{**  Method : TClassFactory.LockServer                             **}
{**                                                                **}
{**  This method increments the DLL reference counter when applying**}
{**  a lock and decrements to unlock the COM server.               **}
{********************************************************************}
function TClassFactory.LockServer(fLock: BOOL): HResult;
begin
  if fLock then
    inc(RefThisDLL)
  else
    dec(RefThisDLL);
  Result:=S_OK;
end;


end.